;;;Tictactoe supervisor
(DEFPROP TICTAC 
     (TICTAC 
     ASK 
     RAND 
     CHOOSEMOVE 
     PRINTBOARD! 
     PRINTBOARD 
     WINNER 
     MEMARRAY 
     TRY)
SUPFNS)

(DEFUN TICTAC ()
   (PROG (ME YOU UFIRST M P0)
        (SSTATUS PUNT NIL) ~allow referential opacity
        (COMMENCE)
    TOP
    	(NEWGAME)
	(SETQ YOU (ASK '|Which mark would you like? (X or O)|))
	(SETQ ME (COND ((EQ YOU 'X) 'O) (T 'X)))
	(SETQ UFIRST (ASK '|Do you want to play first? (Y or N)|))
	(SETQ W (COND ((OR (AND (EQ YOU 'O) (EQ UFIRST 'Y))
                           (AND (EQ YOU 'X) (EQ UFIRST 'N)) ) T) ;O starts
		      (T NIL)) )				 ;X starts

	(COND ((EQ UFIRST 'Y) (GO YOU)))
    ME
	(SETQ P0 P1)  ;Save state
	(RECTIFY (CONS (CHOOSEMOVE P1) P0))
	(COND ((WINNER ME) (TERPRI) (PRINC '|I WIN!!|) (PRINTBOARD) (GO NEXT)))
	(COND ((NULL BS) (TERPRI) (PRINC '|Its a draw|) (PRINTBOARD) (GO NEXT) ))
    YOU
	(PRINTBOARD!)
	(SETQ M (ASK '|What is your move? (position number)|))
	(COND ((NOT (MEMQ M BS)) (PRINT M) (PRINC '| is not a legal move|) (GO YOU)))
	(UPDATE M)
	(COND ((WINNER YOU) (TERPRI) (PRINC '|U WIN!!|) (PRINTBOARD) (GO NEXT)))
	(COND ((NULL BS) (TERPRI) (PRINC '|Its a draw|) (PRINTBOARD) (GO NEXT) ))
	(GO ME)

    NEXT
	(COND ((EQ 'Y (ASK '|Shall we play another game? (Y or N)|)) (GO TOP)))
	(RETURN 'TWAS-FUN!!) ))

(DEFUN CHOOSEMOVE (P)
  (COND ((NULL P) (RAND 11)) 
 	(T (CADR (COND (W (LMIN P -1000 1000)) (T (LMAX P -1000 1000)))) ) )) 

(DEFUN ASK (QUESTION)
    (PROG (ANSWER)
	(TERPRI)
	(PRINC QUESTION)
	(SETQ ANSWER (READ))
	(TERPRI)
	(RETURN ANSWER) ))

(DEFUN RAND (N)
    (PROG (R)
	(SETQ R (ABS (RANDOM)) )
	(SETQ R (DIFFERENCE R (TIMES (QUOTIENT R N) N)))
	(RETURN (COND ((EQ R 0) N) (T R))) ))

(DEFUN PRINTBOARD! ()
    (PROG ()
	(TERPRI)
	(PRINC '|The board positions are numbered as follows:|)
	(TERPRI)
	(PRINC '|(1  2  3)|)
	(TERPRI)
	(PRINC '|(4  5  6)|)
	(TERPRI)
	(PRINC '|(7 10 11)|)
	(TERPRI)
	(PRINC '|The current board looks like:|)
	(PRINTBOARD)))

(DEFUN PRINTBOARD ()
   (PROG (R1 R2 R3)
	(SETQ R1 (LIST
		    (COND ((MEMQ 1 XS) 'X) ((MEMQ 1 OS) 'O) (T '_))
		    (COND ((MEMQ 2 XS) 'X) ((MEMQ 2 OS) 'O) (T '_))
		    (COND ((MEMQ 3 XS) 'X) ((MEMQ 3 OS) 'O) (T '_)) ))
	(SETQ R2 (LIST
		    (COND ((MEMQ 4 XS) 'X) ((MEMQ 4 OS) 'O) (T '_))
		    (COND ((MEMQ 5 XS) 'X) ((MEMQ 5 OS) 'O) (T '_))
		    (COND ((MEMQ 6 XS) 'X) ((MEMQ 6 OS) 'O) (T '_)) ))
	(SETQ R3 (LIST
		    (COND ((MEMQ 7 XS) 'X) ((MEMQ 7 OS) 'O) (T '_))
		    (COND ((MEMQ 10 XS) 'X) ((MEMQ 10 OS) 'O) (T '_))
		    (COND ((MEMQ 11 XS) 'X) ((MEMQ 11 OS) 'O) (T '_)) ))
		
	(PRINT R1)
	(PRINT R2)
	(PRINT R3) 
	(RETURN NIL) ))

(DEFUN WINNER (MARK)
	(COND ((EQ MARK 'X) (MEMARRAY 'XCOUNT 3 11)) (T (MEMARRAY 'OCOUNT 3 11)) ))

(DEFUN MEMARRAY (A X B)
    (PROG (I)
	(SETQ I 0)
    LOOP
	(COND ((EQ (A I) X) (RETURN T)))
	(SETQ I (ADD1 I))
	(COND ((LESSP I B) (GO LOOP)))
	(RETURN NIL) ))

(DEFUN TRY (MODE WW POS)
  (PROG ()
    (NEWGAME)
    (SETQ W WW)
    (MAPC (FUNCTION UPDATE) (REVERSE POS))
    (PRINTBOARD)
    (PRINT 
	(COND ((EQ MODE 'VAL)
	      (COND (W (VLMIN P1 -1000 1000)) (T (VLMAX P1 -1000 1000))))
	      ((EQ MODE 'LINE)
	      (COND (W (LMIN P1 -1000 1000)) (T (LMAX P1 -1000 1000))))
	      ((EQ MODE 'TREE)
	      (COND (W (TMIN P1 -1000 1000)) (T (TMAX P1 -1000 1000)))) )
	) ))